perm filename PK.F4[JEN,LCS] blob
sn#706922 filedate 1983-04-15 generic text, type T, neo UTF8
DIMENSION I(128),L(12800),LO(15000)
C DIMENSION I(128),L(12800),LO(65000)
C**** LOAD WITH MSSIO.FAI[NEW,LCS] *********
TYPE 1
ACCEPT 2,N1
TYPE 4
ACCEPT 2,N2
1 FORMAT(' INPUT 1 -- '$)
2 FORMAT(A5)
4 FORMAT(' OUTPUT -- '$)
10 CALL GETEXT(N1,'VRN')
CALL EXTIN(I,128)
C GET HEADER
CALL PUTEXT(N2,'VRN')
I(1)=-3
CALL EXTOUT(I,128)
NX=12800
K=0
JK=0
KA=0
5 CALL EXTIN(L,12800)
74 N=1
72 LL=L(N)
IF(J.LE.12800)GO TO 78
CALL EXTOUT(LO,12800)
J=J-12800
78 IF(LL.NE.0)GO TO 71
K=K+1
IF(KA.EQ.0)GO TO 75
77 LO(J)=-1
LO(J+1)=KA
C A SERIES OF 1'S
J=J+2
KA=0
75 N=N+1
IF(N.LE.NX)GO TO 72
JK=JK+100
IF(JK.EQ.1700)GO TO 73
C 1700=ALL DONE
TYPE 800,J,JK
800 FORMAT(2I)
CALL EXTIN(L,12800)
GO TO 74
71 IF(K.EQ.0)GO TO 710
LO(J)=0
LO(J+1)=K
C A SERIES OF 0'S
J=J+2
K=0
710 IF(LL.NE.-1)GO TO 76
KA=KA+1
GO TO 75
76 IF(KA.EQ.0)GO TO 79
LO(J)=-1
LO(J+1)=KA
C A SERIES OF 1'S
J=J+2
KA=0
79 LO(J)=L(N)
J=J+1
GO TO 75
73 CALL EXTOUT(LO,J)
CALL FINEXT
END